home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / INIT Shell Folder / INIT Shell ƒ / ShowIcon.p < prev   
Encoding:
Text File  |  1990-03-26  |  2.1 KB  |  97 lines  |  [TEXT/PJMM]
  1. unit ShowIcon;
  2.  
  3. interface
  4.  
  5.     uses
  6.         SysEqu;
  7.  
  8.     procedure ShowIcon (id: INTEGER);
  9.  
  10. implementation
  11.  
  12.     function RegA5: LONGINT;
  13.     inline
  14.         $2E8D;    {MOVE.L A5,(SP)}
  15.  
  16.     procedure SetA5 (where: Ptr);
  17.     inline
  18.         $2A5F;    {MOVEA.L (SP)+,A5}
  19.  
  20.     function CheckH (n: INTEGER): INTEGER;
  21.     inline
  22.         $301F,            {MOVE.W (SP)+,D0}
  23.         $E358,            {ROL.W #1,D0}
  24.         $0A40, $1021,    {EORI.W #$1021,D0}
  25.         $3E80;            {MOVE.W D0,(SP)}
  26.  
  27.     procedure ShowIcon (id: INTEGER);
  28.         const
  29.             HOffsetAddr = CurApName + 28;
  30.             CheckAddr = CurApName + 30;
  31.             hOffset = 40;
  32.             vOffset = 40;
  33.             iconResType = 'ICN#';
  34.  
  35.         type
  36.             ICN = record
  37.                     data: array[1..32] of LONGINT;
  38.                     mask: array[1..32] of LONGINT;
  39.                 end;
  40.             ICNPtr = ^ICN;
  41.             ICNHandle = ^ICNPtr;
  42.             IntPtr = ^INTEGER;
  43.             LongPtr = ^LONGINT;
  44.             OSTypePtr = ^OSType;
  45.             QDGlobals = record
  46.                     private: packed array[1..202] of Byte;
  47.                     thePort: GrafPtr;
  48.                 end;
  49.  
  50.         var
  51.             theIcon: ICNHandle;
  52.             srcRect, dstRect: Rect;
  53.             saveA5: LONGINT;
  54.             myBitMap: BitMap;
  55.             myPort: GrafPort;
  56.             localQD: QDGlobals;
  57.             localA5: LONGINT;
  58.  
  59.     begin
  60.         theIcon := ICNHandle(GetResource(iconResType, id));
  61.         if theIcon <> nil then
  62.             begin
  63.                 HLock(Handle(theIcon));
  64.                 saveA5 := RegA5;
  65.                 SetA5(@localA5);
  66.                 LongPtr(CurrentA5)^ := LONGINT(@localA5);
  67.                 InitGraf(@localQD.thePort);
  68.                 OpenPort(@myPort);
  69.                 if CheckH(IntPtr(HOffsetAddr)^) <> IntPtr(CheckAddr)^ then
  70.                     IntPtr(HOffsetAddr)^ := 8;
  71.                 with myPort, dstRect do
  72.                     begin
  73.                         top := portRect.bottom - vOffset;
  74.                         left := IntPtr(HOffsetAddr)^;
  75.                         bottom := top + 32;
  76.                         right := left + 32;
  77.                     end;
  78.                 with myBitMap do
  79.                     begin
  80.                         baseAddr := @theIcon^^.mask;
  81.                         rowBytes := 4;
  82.                         SetRect(bounds, 0, 0, 32, 32);
  83.                     end;
  84.                 SetRect(srcRect, 0, 0, 32, 32);
  85.                 CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcBic, nil);
  86.                 myBitMap.baseAddr := @theIcon^^.data;
  87.                 CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcOr, nil);
  88.                 IntPtr(HOffsetAddr)^ := IntPtr(HOffsetAddr)^ + hOffset;
  89.                 IntPtr(CheckAddr)^ := CheckH(IntPtr(HOffsetAddr)^);
  90.                 ClosePort(@myPort);
  91.                 ReleaseResource(Handle(theIcon));
  92.                 SetA5(Pointer(saveA5));
  93.                 LongPtr(CurrentA5)^ := saveA5;
  94.             end;
  95.     end;
  96.  
  97. end.